home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / MISC.SWG / 0001_Re: Registration Key unit.pas next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  7.8 KB  |  218 lines
  1.  
  2. {Here is the source code to my unit called EASYKEY: }
  3.  
  4.  
  5. { ********************************************************************* }
  6. { *************       Easy Key version 1.0a        ******************** }
  7. { *************           Copyrite 1995            ******************** }
  8. { *************  by Thomas Moore of Stillwater Ok  ******************** }
  9. { ********************************************************************* }
  10. { ********************************************************************* }
  11. { ********  You may freely use this source code without  ************** }
  12. { ********  fees or royalities, but you may not compile  ************** }
  13. { ********  this as your REGISTRATION KEY program to be  ************** }
  14. { ********  sold.  You may however use this unit in your ************** }
  15. { ********  programs that you sell as registerable.      ************** }
  16. { ********************************************************************* }
  17. { ********************************************************************* }
  18.  
  19. unit EasyKey;
  20.  
  21. Interface
  22. const registered: boolean = false;
  23.       regfile: string = 'easykey.reg';
  24.  
  25. const regcode: array[1..5] of string[40] = ('', '', '', '', '');
  26. const regkey: string[40] = 'KihILijlipienkhppo98656jj;ajggu88k7899o9';
  27. type RegStr = string[40];
  28.  
  29. procedure CheckRegCode(reg_code: regstr);
  30. procedure CheckForReg;
  31. procedure MakeRegFile(filename, sysop_name, bbs_name: string);
  32.  
  33. Implementation
  34.  
  35. var sysop, bbs: string;
  36.  
  37. procedure MakeRegFile(filename, sysop_name, bbs_name: string);
  38. var rgfil: text;
  39.     i: shortint;
  40. begin
  41.      assign(rgfil, filename);
  42.      rewrite(rgfil);
  43.      writeln(rgfil, sysop_name);
  44.      writeln(rgfil, bbs_name);
  45.      CheckRegCode(sysop_name);
  46.      for i := 1 to 5 do writeln(rgfil, regcode[i]);
  47.      CheckRegCode(bbs_name);
  48.      for i := 1 to 5 do writeln(rgfil, regcode[i]);
  49.      close(rgfil);
  50. end;
  51.  
  52. procedure CheckForReg;
  53. var reg: text;
  54.     reginfo: array[1..10] of regstr;
  55.     i: integer;
  56. begin
  57.      registered := false;
  58.      begin
  59.           registered := false;
  60.           assign(reg, regfile);
  61.           {$I-} reset(reg) {I+};
  62.           registered := false;
  63.           if ioresult <> 0 then exit;
  64.           {$I-} readln(reg, sysop) {I+};
  65.           Registered := false;
  66.           if ioresult <> 0 then exit;
  67.           while length(sysop) < 40 do sysop := sysop + #32;
  68.           {$I-} readln(reg, bbs) {I+};
  69.           Registered := false;
  70.           if ioresult <> 0 then exit;
  71.           while length(bbs) < 40 do bbs := bbs + #32;
  72.           for i := 1 to 10 do
  73.           begin
  74.                {$I-} readln(reg, reginfo[i]) {I+};
  75.                Registered := false;
  76.                if ioresult <> 0 then exit;
  77.           end;
  78.      end;
  79.      CheckRegCode(sysop);
  80.      for i := 1 to 5 do
  81.         if regcode[i] <>  reginfo[i] then exit;
  82.      Registered := false;
  83.      CheckRegCode(bbs);
  84.      for i := 6 to 10 do
  85.         if regcode[i - 5] <> reginfo[i] then exit;
  86.      registered := true;
  87. end;
  88.  
  89.  
  90. procedure CheckRegCode(reg_code: regstr);
  91. var i, x: integer;
  92.     tstr: string[4];
  93. begin
  94.      for i := 1 to 5 do regcode[i] := '';
  95.      while length(reg_code) < 40 do
  96.            Reg_Code := Reg_Code + #32;
  97.      while length(regkey) < 40 do regkey := regkey + regkey;
  98.      for i := 1 to 40 do
  99.      begin
  100.           case i of
  101.             1..8: begin
  102.                       if reg_code[i] < regkey[i] then
  103.                       begin
  104.                          str((ord(regkey[i]) - ord(reg_code[i]))
  105.                              + 1000, tstr);
  106.                          regcode[1] := regcode[1] + tstr + #32;
  107.                       end
  108.                       else
  109.                       if reg_code[i] > regkey[i] then
  110.                       begin
  111.                          str((ord(reg_code[i]) - ord(regkey[i]))
  112.                              + 2000, tstr);
  113.                          regcode[1] := regcode[1] + tstr + #32;
  114.                       end
  115.                       else
  116.                       begin
  117.                            str(ord(regkey[i]) + 3000, tstr);
  118.                            regcode[1] := regcode[1] + tstr + #32;
  119.                       end;
  120.                    end;
  121.             9..16: begin
  122.                       if reg_code[i] < regkey[i] then
  123.                       begin
  124.                          str((ord(regkey[i]) - ord(reg_code[i]))
  125.                              + 1000, tstr);
  126.                          regcode[2] := regcode[2] + tstr + #32;
  127.                       end
  128.                       else
  129.                       if reg_code[i] > regkey[i] then
  130.                       begin
  131.                          str((ord(reg_code[i]) - ord(regkey[i]))
  132.                              + 2000, tstr);
  133.                          regcode[2] := regcode[2] + tstr + #32;
  134.                       end
  135.                       else
  136.                       begin
  137.                            str(ord(regkey[i]) + 3000, tstr);
  138.                            regcode[2] := regcode[2] + tstr + #32;
  139.                       end;
  140.                     end;
  141.             17..24: begin
  142.                       if reg_code[i] < regkey[i] then
  143.                       begin
  144.                          str((ord(regkey[i]) - ord(reg_code[i]))
  145.                              + 1000, tstr);
  146.                          regcode[3] := regcode[3] + tstr + #32;
  147.                       end
  148.                       else
  149.                       if reg_code[i] > regkey[i] then
  150.                       begin
  151.                          str((ord(reg_code[i]) - ord(regkey[i]))
  152.                              + 2000, tstr);
  153.                          regcode[3] := regcode[3] + tstr + #32;
  154.                       end
  155.                       else
  156.                       begin
  157.                            str(ord(regkey[i]) + 3000, tstr);
  158.                            regcode[3] := regcode[3] + tstr + #32;
  159.                       end;
  160.                     end;
  161.             25..32: begin
  162.                       if reg_code[i] < regkey[i] then
  163.                       begin
  164.                          str((ord(regkey[i]) - ord(reg_code[i]))
  165.                              + 1000, tstr);
  166.                          regcode[4] := regcode[4] + tstr + #32;
  167.                       end
  168.                       else
  169.                       if reg_code[i] > regkey[i] then
  170.                       begin
  171.                          str((ord(reg_code[i]) - ord(regkey[i]))
  172.                              + 2000, tstr);
  173.                          regcode[4] := regcode[4] + tstr + #32;
  174.                       end
  175.                       else
  176.                       begin
  177.                            str(ord(regkey[i]) + 3000, tstr);
  178.                            regcode[4] := regcode[4] + tstr + #32;
  179.                       end;
  180.                     end;
  181.             33..40: begin
  182.                       if reg_code[i] < regkey[i] then
  183.                       begin
  184.                          str((ord(regkey[i]) - ord(reg_code[i]))
  185.                              + 1000, tstr);
  186.                          regcode[5] := regcode[5] + tstr + #32;
  187.                       end
  188.                       else
  189.                       if reg_code[i] > regkey[i] then
  190.                       begin
  191.                          str((ord(reg_code[i]) - ord(regkey[i]))
  192.                              + 2000, tstr);
  193.                          regcode[5] := regcode[5] + tstr + #32;
  194.                       end
  195.                       else
  196.                       begin
  197.                            str(ord(regkey[i]) + 3000, tstr);
  198.                            regcode[5] := regcode[5] + tstr + #32;
  199.                       end;
  200.                     end;
  201.           end;
  202.      end;
  203. end;
  204.  
  205. begin
  206. end.
  207.  
  208.  
  209. I also have a doc file that comes with it if you would like to FREQ it from 
  210. my system it is in a file called EASYKEY.ZIP.
  211.  
  212. SWAG TEAM, if you would like to include this in a swag packett, I would be
  213. delighted.
  214.  
  215. Regards,
  216. Tom Moore
  217.  
  218.